1 Introdução

Este exercício prático demonstra como aplicar técnicas de análise de cluster para segmentar pacientes com base em indicadores de saúde. A identificação de subgrupos de pacientes pode ajudar no desenvolvimento de intervenções personalizadas, otimização de recursos e melhoria nos cuidados de saúde.

1.1 Contexto do Problema

Uma clínica especializada em saúde metabólica deseja identificar padrões entre seus pacientes para desenvolver programas de tratamento mais personalizados. A clínica coletou dados de diversos indicadores de saúde e agora precisa de uma análise para identificar grupos naturais de pacientes com características similares.

1.2 Objetivos do Exercício

  1. Identificar subgrupos significativos de pacientes com base em indicadores de saúde
  2. Determinar o número ideal de grupos usando métodos estatísticos
  3. Caracterizar cada grupo e suas necessidades clínicas específicas
  4. Propor intervenções personalizadas para cada grupo identificado

1.3 Carregando os Pacotes Necessários

# Pacotes para manipulação e visualização de dados
library(tidyverse)  # Manipulação e visualização de dados
library(cluster)    # Algoritmos de clustering
library(factoextra) # Visualização de clusters
library(NbClust)    # Determinar número ótimo de clusters
library(fpc)        # Estatísticas de validação de cluster
library(corrplot)   # Visualização de matrizes de correlação
library(gridExtra)  # Organização de múltiplos gráficos
library(psych)      # Estatísticas descritivas

# Definir a semente aleatória para reprodutibilidade
set.seed(123)

2 Dados de Pacientes

Para este exercício, utilizaremos um conjunto de dados simulados que representa perfis de saúde de pacientes.

# Número de pacientes
n <- 400

# Simular diferentes perfis de pacientes
# Perfil 1: Pacientes com maior risco cardiovascular
grupo1 <- data.frame(
  idade = rnorm(n/4, mean = 62, sd = 8),
  imc = rnorm(n/4, mean = 32, sd = 4),  # Obesidade
  pressao_sistolica = rnorm(n/4, mean = 148, sd = 15),  # Hipertensão
  glicose_jejum = rnorm(n/4, mean = 105, sd = 15),  # Normal alto
  hdl = rnorm(n/4, mean = 38, sd = 5),  # Baixo
  ldl = rnorm(n/4, mean = 155, sd = 20),  # Alto
  triglicerideos = rnorm(n/4, mean = 190, sd = 45),  # Alto
  a1c = rnorm(n/4, mean = 6.0, sd = 0.7),  # Normal alto
  proteina_c_reativa = rnorm(n/4, mean = 4.5, sd = 2.5),  # Elevada (inflamação)
  atividade_fisica = rnorm(n/4, mean = 2, sd = 1.5)  # Baixa (horas/semana)
)

# Perfil 2: Pacientes com diabetes não controlado
grupo2 <- data.frame(
  idade = rnorm(n/4, mean = 55, sd = 10),
  imc = rnorm(n/4, mean = 31, sd = 3.5),  # Obesidade
  pressao_sistolica = rnorm(n/4, mean = 135, sd = 10),  # Ligeiramente elevada
  glicose_jejum = rnorm(n/4, mean = 180, sd = 30),  # Muito alta
  hdl = rnorm(n/4, mean = 42, sd = 6),  # Ligeiramente baixo
  ldl = rnorm(n/4, mean = 130, sd = 25),  # Moderado
  triglicerideos = rnorm(n/4, mean = 160, sd = 40),  # Moderadamente alto
  a1c = rnorm(n/4, mean = 8.5, sd = 1.2),  # Elevado
  proteina_c_reativa = rnorm(n/4, mean = 3.0, sd = 1.8),  # Moderada
  atividade_fisica = rnorm(n/4, mean = 3, sd = 2)  # Moderada
)

# Perfil 3: Jovens com fatores de risco
grupo3 <- data.frame(
  idade = rnorm(n/4, mean = 35, sd = 7),
  imc = rnorm(n/4, mean = 27, sd = 3.5),  # Sobrepeso
  pressao_sistolica = rnorm(n/4, mean = 125, sd = 10),  # Normal
  glicose_jejum = rnorm(n/4, mean = 98, sd = 10),  # Normal
  hdl = rnorm(n/4, mean = 45, sd = 8),  # Moderado
  ldl = rnorm(n/4, mean = 125, sd = 20),  # Limítrofe
  triglicerideos = rnorm(n/4, mean = 150, sd = 35),  # Limítrofe
  a1c = rnorm(n/4, mean = 5.5, sd = 0.3),  # Normal
  proteina_c_reativa = rnorm(n/4, mean = 2.0, sd = 1.0),  # Normal
  atividade_fisica = rnorm(n/4, mean = 3.5, sd = 2.5)  # Moderada
)

# Perfil 4: Pacientes saudáveis
grupo4 <- data.frame(
  idade = rnorm(n/4, mean = 45, sd = 12),
  imc = rnorm(n/4, mean = 23, sd = 2),  # Saudável
  pressao_sistolica = rnorm(n/4, mean = 115, sd = 8),  # Ótima
  glicose_jejum = rnorm(n/4, mean = 85, sd = 7),  # Normal
  hdl = rnorm(n/4, mean = 58, sd = 7),  # Bom
  ldl = rnorm(n/4, mean = 95, sd = 15),  # Ótimo
  triglicerideos = rnorm(n/4, mean = 95, sd = 25),  # Normal
  a1c = rnorm(n/4, mean = 5.2, sd = 0.2),  # Normal
  proteina_c_reativa = rnorm(n/4, mean = 0.8, sd = 0.5),  # Baixa
  atividade_fisica = rnorm(n/4, mean = 7, sd = 2)  # Alta
)

# Combinar todos os grupos
pacientes <- rbind(grupo1, grupo2, grupo3, grupo4)

# Assegurar que os valores sejam realistas
pacientes <- pacientes %>%
  mutate(
    imc = pmax(16, pmin(45, imc)),  # Limitar IMC entre 16 e 45
    pressao_sistolica = pmax(90, pmin(220, pressao_sistolica)),  # Limitar pressão
    glicose_jejum = pmax(60, pmin(300, glicose_jejum)),  # Limitar glicose
    hdl = pmax(20, pmin(90, hdl)),  # Limitar HDL
    ldl = pmax(50, pmin(250, ldl)),  # Limitar LDL
    triglicerideos = pmax(40, pmin(400, triglicerideos)),  # Limitar triglicerídeos
    a1c = pmax(4.0, pmin(12.0, a1c)),  # Limitar A1C
    proteina_c_reativa = pmax(0.1, pmin(10.0, proteina_c_reativa)),  # Limitar PCR
    atividade_fisica = pmax(0, pmin(14, atividade_fisica))  # Limitar atividade física
  )

# Adicionar um ID para cada paciente
pacientes$id_paciente <- 1:nrow(pacientes)

# Verificar a estrutura dos dados
glimpse(pacientes)
## Rows: 400
## Columns: 11
## $ idade              <dbl> 57.51619, 60.15858, 74.46967, 62.56407, 63.03430, 7…
## $ imc                <dbl> 29.15837, 33.02753, 31.01323, 30.60983, 28.19353, 3…
## $ pressao_sistolica  <dbl> 180.9822, 167.6862, 144.0228, 156.1479, 141.7849, 1…
## $ glicose_jejum      <dbl> 94.27137, 93.70967, 90.92192, 89.21230, 98.44261, 1…
## $ hdl                <dbl> 37.63222, 32.15674, 34.82626, 37.85579, 41.35348, 2…
## $ ldl                <dbl> 142.9621, 135.1260, 175.5357, 170.0212, 124.8167, 1…
## $ triglicerideos     <dbl> 238.33055, 188.76939, 188.50013, 121.77696, 225.567…
## $ a1c                <dbl> 5.490247, 4.921690, 5.514834, 6.083195, 5.044703, 6…
## $ proteina_c_reativa <dbl> 5.3907084, 2.8549745, 6.6380055, 7.3823406, 5.19068…
## $ atividade_fisica   <dbl> 0.4788287, 0.8130292, 2.4493905, 4.4585779, 3.62692…
## $ id_paciente        <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, …
# Estatísticas descritivas dos dados
summary(pacientes)
##      idade             imc        pressao_sistolica glicose_jejum   
##  Min.   : 9.984   Min.   :18.22   Min.   : 91.4     Min.   : 65.12  
##  1st Qu.:37.414   1st Qu.:24.02   1st Qu.:118.5     1st Qu.: 88.19  
##  Median :50.482   Median :27.94   Median :130.1     Median :101.43  
##  Mean   :49.362   Mean   :27.93   Mean   :131.0     Mean   :116.68  
##  3rd Qu.:60.241   3rd Qu.:31.16   3rd Qu.:141.2     3rd Qu.:129.20  
##  Max.   :83.322   Max.   :44.96   Max.   :182.4     Max.   :281.71  
##       hdl             ldl         triglicerideos       a1c        
##  Min.   :24.70   Min.   : 60.22   Min.   : 40.0   Min.   : 4.453  
##  1st Qu.:38.98   1st Qu.:105.75   1st Qu.:108.2   1st Qu.: 5.243  
##  Median :44.53   Median :128.61   Median :142.9   Median : 5.695  
##  Mean   :45.95   Mean   :127.05   Mean   :146.9   Mean   : 6.314  
##  3rd Qu.:52.20   3rd Qu.:147.59   3rd Qu.:186.4   3rd Qu.: 7.017  
##  Max.   :72.54   Max.   :203.60   Max.   :300.6   Max.   :11.593  
##  proteina_c_reativa atividade_fisica  id_paciente   
##  Min.   : 0.1000    Min.   : 0.000   Min.   :  1.0  
##  1st Qu.: 0.9493    1st Qu.: 1.874   1st Qu.:100.8  
##  Median : 2.0497    Median : 3.533   Median :200.5  
##  Mean   : 2.6979    Mean   : 4.093   Mean   :200.5  
##  3rd Qu.: 4.0247    3rd Qu.: 6.047   3rd Qu.:300.2  
##  Max.   :10.0000    Max.   :12.790   Max.   :400.0

3 Exercício 1: Exploração e Preparação dos Dados

3.1 1.1 Análise Exploratória

# Estatísticas descritivas detalhadas
describe(pacientes[, 1:10])  # Excluir a coluna de ID
##                    vars   n   mean    sd median trimmed   mad   min    max
## idade                 1 400  49.36 14.56  50.48   49.42 17.04  9.98  83.32
## imc                   2 400  27.93  4.77  27.94   27.74  5.37 18.22  44.96
## pressao_sistolica     3 400 131.01 16.67 130.13  129.99 16.56 91.40 182.40
## glicose_jejum         4 400 116.68 40.45 101.43  110.17 22.42 65.12 281.71
## hdl                   5 400  45.95  9.87  44.53   45.40  8.99 24.70  72.54
## ldl                   6 400 127.05 28.26 128.61  127.16 30.39 60.22 203.60
## triglicerideos        7 400 146.91 50.54 142.88  145.61 58.90 40.00 300.61
## a1c                   8 400   6.31  1.51   5.69    6.07  0.86  4.45  11.59
## proteina_c_reativa    9 400   2.70  2.18   2.05    2.42  1.83  0.10  10.00
## atividade_fisica     10 400   4.09  2.88   3.53    3.91  3.05  0.00  12.79
##                     range  skew kurtosis   se
## idade               73.34 -0.08    -0.84 0.73
## imc                 26.74  0.37    -0.19 0.24
## pressao_sistolica   91.00  0.54     0.18 0.83
## glicose_jejum      216.59  1.34     0.91 2.02
## hdl                 47.84  0.51    -0.27 0.49
## ldl                143.38 -0.03    -0.63 1.41
## triglicerideos     260.61  0.25    -0.48 2.53
## a1c                  7.14  1.31     0.81 0.08
## proteina_c_reativa   9.90  1.10     0.77 0.11
## atividade_fisica    12.79  0.54    -0.46 0.14
# Matriz de correlação
matriz_cor <- cor(pacientes[, 1:10])
corrplot(matriz_cor, method = "circle", type = "upper", 
         tl.col = "black", tl.cex = 0.7, tl.srt = 45,
         title = "Matriz de Correlação dos Indicadores de Saúde")

# Histogramas das variáveis
pacientes %>%
  select(-id_paciente) %>%
  gather() %>%
  ggplot(aes(value)) +
  geom_histogram(bins = 30, fill = "steelblue", color = "black", alpha = 0.7) +
  facet_wrap(~ key, scales = "free") +
  theme_minimal() +
  labs(title = "Distribuição dos Indicadores de Saúde",
       x = "Valor", y = "Frequência")

# Verificação de valores faltantes
sum(is.na(pacientes))
## [1] 0

3.2 1.2 Preparação dos Dados para Clustering

# Selecionar apenas as variáveis relevantes para clustering
dados_cluster <- pacientes[, 1:10]  # Todas as variáveis exceto o ID

# Padronização dos dados (Z-score)
dados_padronizados <- scale(dados_cluster)
summary(dados_padronizados)
##      idade               imc            pressao_sistolica  glicose_jejum    
##  Min.   :-2.70424   Min.   :-2.037231   Min.   :-2.37574   Min.   :-1.2746  
##  1st Qu.:-0.82051   1st Qu.:-0.819886   1st Qu.:-0.75102   1st Qu.:-0.7043  
##  Median : 0.07692   Median : 0.001705   Median :-0.05293   Median :-0.3771  
##  Mean   : 0.00000   Mean   : 0.000000   Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.74714   3rd Qu.: 0.676452   3rd Qu.: 0.61376   3rd Qu.: 0.3094  
##  Max.   : 2.33223   Max.   : 3.573117   Max.   : 3.08168   Max.   : 4.0797  
##       hdl               ldl           triglicerideos          a1c         
##  Min.   :-2.1530   Min.   :-2.36482   Min.   :-2.11525   Min.   :-1.2309  
##  1st Qu.:-0.7061   1st Qu.:-0.75369   1st Qu.:-0.76493   1st Qu.:-0.7081  
##  Median :-0.1439   Median : 0.05543   Median :-0.07961   Median :-0.4097  
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.6329   3rd Qu.: 0.72702   3rd Qu.: 0.78068   3rd Qu.: 0.4646  
##  Max.   : 2.6922   Max.   : 2.70926   Max.   : 3.04118   Max.   : 3.4902  
##  proteina_c_reativa atividade_fisica 
##  Min.   :-1.1935    Min.   :-1.4229  
##  1st Qu.:-0.8033    1st Qu.:-0.7715  
##  Median :-0.2978    Median :-0.1949  
##  Mean   : 0.0000    Mean   : 0.0000  
##  3rd Qu.: 0.6095    3rd Qu.: 0.6792  
##  Max.   : 3.3546    Max.   : 3.0228
# Verificar se a padronização foi bem-sucedida
colMeans(dados_padronizados)  # Deve ser próximo de 0
##              idade                imc  pressao_sistolica      glicose_jejum 
##       2.106648e-15       5.911938e-16      -8.323342e-15      -2.461920e-16 
##                hdl                ldl     triglicerideos                a1c 
##       1.105782e-15      -2.590705e-15      -7.792378e-16       1.112721e-15 
## proteina_c_reativa   atividade_fisica 
##      -1.214306e-15       1.018075e-15
apply(dados_padronizados, 2, sd)  # Deve ser próximo de 1
##              idade                imc  pressao_sistolica      glicose_jejum 
##                  1                  1                  1                  1 
##                hdl                ldl     triglicerideos                a1c 
##                  1                  1                  1                  1 
## proteina_c_reativa   atividade_fisica 
##                  1                  1
# Avaliação da tendência de clustering
# Nota: A função hopkins() pode não estar disponível em algumas instalações
# Vamos verificar se o pacote clustertend está carregado e, se necessário, usar uma abordagem alternativa
if(!requireNamespace("clustertend", quietly = TRUE)) {
  cat("O pacote 'clustertend' não está instalado. Usando método alternativo.\n")
  
  # Método alternativo: comparar a distribuição de distâncias original com uma aleatória
  set.seed(123)
  dist_original <- as.vector(dist(dados_padronizados))
  
  # Criar um conjunto de dados aleatório com a mesma dimensionalidade
  dados_aleatorios <- matrix(runif(prod(dim(dados_padronizados))), 
                             nrow = nrow(dados_padronizados))
  dist_aleatorio <- as.vector(dist(dados_aleatorios))
  
  # Calcular a diferença nas médias das distâncias
  media_orig <- mean(dist_original)
  media_aleat <- mean(dist_aleatorio)
  tendencia_valor <- media_aleat / (media_orig + media_aleat)
  
  cat("Estatística de tendência clustering alternativa:", round(tendencia_valor, 3), "\n")
} else {
  # Usar a função hopkins do pacote clustertend se disponível
  library(clustertend)
  set.seed(123)
  tendencia <- clustertend::hopkins(dados_padronizados, n = nrow(dados_padronizados) * 0.1)
  tendencia_valor <- as.numeric(tendencia)
  cat("Estatística de Hopkins:", round(tendencia_valor, 3), "\n")
}
## Estatística de Hopkins: 0.312
cat("Interpretação: Valores acima de 0.5 sugerem tendência de clustering.\n",
    "Quanto mais próximo de 1, maior a tendência.\n")
## Interpretação: Valores acima de 0.5 sugerem tendência de clustering.
##  Quanto mais próximo de 1, maior a tendência.

4 Exercício 2: Determinação do Número Ótimo de Clusters

4.1 2.1 Métodos Visuais

# Método do cotovelo (Elbow Method)
fviz_nbclust(dados_padronizados, kmeans, method = "wss", k.max = 10) +
  labs(title = "Método do Cotovelo (Elbow Method)",
       subtitle = "Soma dos quadrados dentro dos clusters vs. Número de clusters")

# Método da silhueta
fviz_nbclust(dados_padronizados, kmeans, method = "silhouette", k.max = 10) +
  labs(title = "Método da Silhueta",
       subtitle = "Largura média da silhueta vs. Número de clusters")

# Gap statistic
# Nota: Pode ser computacionalmente intensivo
# Usar uma amostra para tornar o cálculo mais rápido
set.seed(123)
amostra_indices <- sample(1:nrow(dados_padronizados), 100)
gap_stat <- clusGap(dados_padronizados[amostra_indices, ], 
                    FUN = kmeans, 
                    nstart = 25,
                    K.max = 10, 
                    B = 50)
fviz_gap_stat(gap_stat) +
  labs(title = "Gap Statistic",
       subtitle = "Gap statistic vs. Número de clusters")

4.2 2.2 Índices de Validação (NbClust)

# Este código pode ser computacionalmente intensivo
# Descomente e execute se desejar uma avaliação mais completa
# set.seed(123)
# res.nbclust <- NbClust(dados_padronizados, 
#                        distance = "euclidean",
#                        min.nc = 2, 
#                        max.nc = 10, 
#                        method = "kmeans")
# 
# # Resumir os resultados
# freq_k <- table(res.nbclust$Best.nc[1,])
# 
# # Visualizar o número de clusters sugerido por múltiplos índices
# barplot(freq_k, 
#         xlab = "Número de Clusters", 
#         ylab = "Número de Critérios",
#         main = "Número Ótimo de Clusters")

Pergunta: Com base nos métodos usados, qual você acredita ser o número ideal de clusters para este conjunto de dados de pacientes? Justifique sua resposta.

5 Exercício 3: Aplicação de Algoritmos de Clustering

5.1 3.1 K-means Clustering

# Aplicar K-means com o número selecionado de clusters (suponha k=4)
set.seed(123)
k_selecionado <- 4  # Ajuste este valor conforme sua análise acima
kmeans_resultado <- kmeans(dados_padronizados, centers = k_selecionado, nstart = 25)

# Adicionar os clusters ao dataframe original
pacientes$cluster_kmeans <- kmeans_resultado$cluster

# Visualizar os clusters
fviz_cluster(kmeans_resultado, data = dados_padronizados,
             palette = "jco",
             ellipse.type = "convex",
             repel = TRUE,
             ggtheme = theme_minimal()) +
  labs(title = "Clusters de Pacientes (K-means)",
       subtitle = paste("K =", k_selecionado))

# Avaliação da qualidade do clustering - Silhueta
silhueta_kmeans <- silhouette(kmeans_resultado$cluster, dist(dados_padronizados))
fviz_silhouette(silhueta_kmeans) +
  labs(title = "Análise de Silhueta para K-means")
##   cluster size ave.sil.width
## 1       1   97          0.26
## 2       2  100          0.25
## 3       3   98          0.22
## 4       4  105          0.34

# Média da silhueta por cluster
media_silhueta <- mean(silhueta_kmeans[, "sil_width"])
cat("Coeficiente de silhueta médio:", round(media_silhueta, 3), "\n")
## Coeficiente de silhueta médio: 0.27

5.2 3.2 Clustering Hierárquico

# Cálculo da matriz de distância
dist_matriz <- dist(dados_padronizados, method = "euclidean")

# Aplicar clustering hierárquico usando o método de Ward
hc_ward <- hclust(dist_matriz, method = "ward.D2")

# Visualizar o dendrograma
plot(hc_ward, main = "Dendrograma - Método de Ward", 
     xlab = "", sub = "", cex = 0.6)
rect.hclust(hc_ward, k = k_selecionado, border = 2:5)

# Cortar o dendrograma para obter clusters
clusters_hc <- cutree(hc_ward, k = k_selecionado)

# Adicionar os clusters ao dataframe original
pacientes$cluster_hc <- clusters_hc

# Visualizar os clusters
fviz_cluster(list(data = dados_padronizados, cluster = clusters_hc),
             palette = "jco",
             ellipse.type = "convex",
             repel = TRUE,
             ggtheme = theme_minimal()) +
  labs(title = "Clusters de Pacientes (Hierárquico)",
       subtitle = paste("K =", k_selecionado))

# Avaliação da qualidade - Silhueta
silhueta_hc <- silhouette(clusters_hc, dist_matriz)
fviz_silhouette(silhueta_hc) +
  labs(title = "Análise de Silhueta para Clustering Hierárquico")
##   cluster size ave.sil.width
## 1       1   99          0.25
## 2       2  101          0.22
## 3       3  105          0.22
## 4       4   95          0.36

# Média da silhueta
media_silhueta_hc <- mean(silhueta_hc[, "sil_width"])
cat("Coeficiente de silhueta médio (Hierárquico):", round(media_silhueta_hc, 3), "\n")
## Coeficiente de silhueta médio (Hierárquico): 0.261

5.3 3.3 Comparação entre K-means e Hierárquico

# Tabela de contingência entre os dois métodos
tabela_comp <- table(K_means = pacientes$cluster_kmeans, 
                     Hierarquico = pacientes$cluster_hc)
print(tabela_comp)
##        Hierarquico
## K_means  1  2  3  4
##       1  0  2 95  0
##       2 98  2  0  0
##       3  1 97  0  0
##       4  0  0 10 95
# Índice Rand Ajustado (ARI) - necessita do pacote mclust
if (!requireNamespace("mclust", quietly = TRUE)) {
  cat("Pacote 'mclust' não disponível. Não é possível calcular o Índice Rand Ajustado.\n")
  
  # Alternativa simples: calcular a proporção de concordância
  n_total <- nrow(pacientes)
  concordancia <- sum(diag(prop.table(tabela_comp)))
  cat("Proporção de concordância entre métodos:", round(concordancia, 3), "\n")
  cat("Interpretação: Valores próximos de 1 indicam alta concordância entre os métodos.\n")
} else {
  # Usar a função adjustedRandIndex do pacote mclust
  ari <- mclust::adjustedRandIndex(pacientes$cluster_kmeans, pacientes$cluster_hc)
  cat("Índice Rand Ajustado:", round(ari, 3), "\n")
  cat("Interpretação: Valores próximos de 1 indicam alta concordância entre os métodos.\n")
}
## Índice Rand Ajustado: 0.904 
## Interpretação: Valores próximos de 1 indicam alta concordância entre os métodos.
# Para fins deste exercício, continuaremos com os resultados do K-means
pacientes$cluster_final <- pacientes$cluster_kmeans

Pergunta: Qual dos dois métodos (K-means ou Hierárquico) você acredita que produziu clusters mais coerentes para este conjunto de dados? Justifique com base nas visualizações e métricas de avaliação.

6 Exercício 4: Caracterização e Interpretação dos Clusters

6.1 4.1 Perfil dos Clusters

# Estatísticas por cluster
perfil_clusters <- pacientes %>%
  select(-id_paciente, -cluster_kmeans, -cluster_hc) %>%
  group_by(cluster_final) %>%
  summarise(across(everything(), list(média = mean, dp = sd)),
            n_pacientes = n(),
            prop_pacientes = n() / nrow(pacientes) * 100)

# Exibir o perfil de cada cluster
print(perfil_clusters)
## # A tibble: 4 × 23
##   cluster_final idade_média idade_dp imc_média imc_dp pressao_sistolica_média
##           <int>       <dbl>    <dbl>     <dbl>  <dbl>                   <dbl>
## 1             1        34.4     6.59      26.6   3.10                    125.
## 2             2        62.7     7.30      31.6   3.87                    150.
## 3             3        56.4    10.4       31.0   3.50                    135.
## 4             4        44.0    12.8       22.9   1.87                    115.
## # ℹ 17 more variables: pressao_sistolica_dp <dbl>, glicose_jejum_média <dbl>,
## #   glicose_jejum_dp <dbl>, hdl_média <dbl>, hdl_dp <dbl>, ldl_média <dbl>,
## #   ldl_dp <dbl>, triglicerideos_média <dbl>, triglicerideos_dp <dbl>,
## #   a1c_média <dbl>, a1c_dp <dbl>, proteina_c_reativa_média <dbl>,
## #   proteina_c_reativa_dp <dbl>, atividade_fisica_média <dbl>,
## #   atividade_fisica_dp <dbl>, n_pacientes <int>, prop_pacientes <dbl>
# Visualização do perfil dos clusters - valores médios
perfil_viz <- pacientes %>%
  select(-id_paciente, -cluster_kmeans, -cluster_hc) %>%
  group_by(cluster_final) %>%
  summarise(across(everything(), mean)) %>%
  pivot_longer(cols = -cluster_final, 
               names_to = "variavel", 
               values_to = "valor")

# Padronizar os valores para o gráfico de radar
perfil_viz_norm <- perfil_viz %>%
  group_by(variavel) %>%
  mutate(valor_padronizado = (valor - min(valor)) / (max(valor) - min(valor)))

# Gráfico de radar para comparar os perfis dos clusters
ggplot(perfil_viz_norm, 
       aes(x = variavel, y = valor_padronizado, 
           group = factor(cluster_final), 
           color = factor(cluster_final))) +
  geom_line() +
  geom_point() +
  coord_polar() +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        legend.position = "bottom") +
  labs(title = "Perfil dos Clusters de Pacientes",
       subtitle = "Valores médios padronizados",
       color = "Cluster") +
  scale_color_brewer(palette = "Set1")

6.2 4.2 Análise Detalhada de Cada Variável por Cluster

# Função para criar boxplot para uma variável específica
criar_boxplot <- function(var_nome) {
  ggplot(pacientes, aes(x = factor(cluster_final), y = .data[[var_nome]], 
                        fill = factor(cluster_final))) +
    geom_boxplot() +
    theme_minimal() +
    labs(title = paste("Distribuição de", var_nome, "por Cluster"),
         x = "Cluster", y = var_nome) +
    scale_fill_brewer(palette = "Set1") +
    theme(legend.position = "none")
}

# Criar boxplots para cada variável
variaveis <- names(pacientes)[1:10]  # Primeiras 10 variáveis (excluindo IDs e clusters)
boxplots <- lapply(variaveis, criar_boxplot)

# Organizar os boxplots em uma grade (2x5)
do.call(gridExtra::grid.arrange, c(boxplots, ncol = 2))

6.3 4.3 Interpretação Clínica dos Clusters

Com base nas análises acima, vamos interpretar cada um dos clusters no contexto clínico:

Interpretação Clínica dos Clusters
Cluster Caracteristicas Intervencoes_Sugeridas
1 Preencher com base nos resultados Preencher com base nos resultados
2 Preencher com base nos resultados Preencher com base nos resultados
3 Preencher com base nos resultados Preencher com base nos resultados
4 Preencher com base nos resultados Preencher com base nos resultados

Exercício: Complete a tabela acima com: 1. As principais características de cada cluster, baseado nas análises realizadas. 2. Intervenções clínicas personalizadas que você recomendaria para cada grupo.

7 Exercício 5: Desafios Adicionais

7.1 5.1 Validação Cruzada (opcional)

# Função para realizar validação cruzada do clustering
validacao_cruzada_kmeans <- function(dados, k, n_folds = 5) {
  set.seed(123)
  n <- nrow(dados)
  fold_indices <- sample(rep(1:n_folds, length.out = n))
  
  resultados <- data.frame(fold = 1:n_folds, silhueta = NA)
  
  for (i in 1:n_folds) {
    # Dividir dados em treino e teste
    dados_treino <- dados[fold_indices != i, ]
    dados_teste <- dados[fold_indices == i, ]
    
    # Treinar modelo em dados de treino
    modelo <- kmeans(dados_treino, centers = k, nstart = 25)
    
    # Atribuir clusters para dados de teste
    distancias <- matrix(NA, nrow = nrow(dados_teste), ncol = k)
    for (j in 1:nrow(dados_teste)) {
      for (l in 1:k) {
        distancias[j, l] <- sqrt(sum((dados_teste[j, ] - modelo$centers[l, ])^2))
      }
    }
    clusters_teste <- apply(distancias, 1, which.min)
    
    # Calcular silhueta nos dados de teste
    dist_teste <- dist(dados_teste)
    sil <- silhouette(clusters_teste, dist_teste)
    resultados$silhueta[i] <- mean(sil[, "sil_width"])
  }
  
  return(resultados)
}

# Aplicar validação cruzada para k=4
vc_resultados <- validacao_cruzada_kmeans(dados_padronizados, k = k_selecionado)
print(vc_resultados)

# Calcular média e desvio padrão da silhueta entre os folds
cat("Média da silhueta (validação cruzada):", mean(vc_resultados$silhueta), "\n")
cat("Desvio padrão da silhueta:", sd(vc_resultados$silhueta), "\n")

7.2 5.2 Análise de Sensibilidade

Como o algoritmo K-means depende da inicialização aleatória, é importante verificar a estabilidade dos resultados.

# Função para executar K-means múltiplas vezes
executar_kmeans_multiplas <- function(dados, k, n_execucoes = 30) {
  resultados <- data.frame(execucao = 1:n_execucoes, 
                           wcss = NA,  # Within-cluster sum of squares
                           silhueta = NA)
  
  clusters_matriz <- matrix(NA, nrow = nrow(dados), ncol = n_execucoes)
  
  for (i in 1:n_execucoes) {
    set.seed(i * 100)  # Sementes diferentes para cada execução
    km <- kmeans(dados, centers = k, nstart = 25)
    
    resultados$wcss[i] <- km$tot.withinss
    
    sil <- silhouette(km$cluster, dist(dados))
    resultados$silhueta[i] <- mean(sil[, "sil_width"])
    
    clusters_matriz[, i] <- km$cluster
  }
  
  # Calcular concordância entre pares de execuções
  if (!requireNamespace("mclust", quietly = TRUE)) {
    # Alternativa se mclust não estiver disponível
    ari_matriz <- matrix(NA, nrow = n_execucoes, ncol = n_execucoes)
    for (i in 1:n_execucoes) {
      for (j in 1:n_execucoes) {
        if (i != j) {
          # Calcular proporção de concordância como alternativa ao ARI
          tabela <- table(clusters_matriz[, i], clusters_matriz[, j])
          ari_matriz[i, j] <- sum(diag(prop.table(tabela)))
        } else {
          ari_matriz[i, j] <- 1  # Diagonal (mesma execução)
        }
      }
    }
    metrica_nome <- "Proporção de Concordância"
  } else {
    # Usar adjustedRandIndex se mclust estiver disponível
    ari_matriz <- matrix(NA, nrow = n_execucoes, ncol = n_execucoes)
    for (i in 1:n_execucoes) {
      for (j in 1:n_execucoes) {
        if (i != j) {
          ari_matriz[i, j] <- mclust::adjustedRandIndex(
            clusters_matriz[, i], clusters_matriz[, j])
        } else {
          ari_matriz[i, j] <- 1  # Diagonal (mesma execução)
        }
      }
    }
    metrica_nome <- "Índice Rand Ajustado"
  }
  
  return(list(
    resultados = resultados,
    ari_matriz = ari_matriz,
    ari_medio = mean(ari_matriz[lower.tri(ari_matriz)]),
    metrica_nome = metrica_nome
  ))
}

# Executar análise de sensibilidade
sensibilidade <- executar_kmeans_multiplas(dados_padronizados, k = k_selecionado, n_execucoes = 10)

# Visualizar os resultados
ggplot(sensibilidade$resultados, aes(x = execucao)) +
  geom_line(aes(y = wcss, color = "WCSS")) +
  geom_line(aes(y = silhueta * max(sensibilidade$resultados$wcss) * 2, color = "Silhueta")) +
  scale_y_continuous(
    name = "WCSS",
    sec.axis = sec_axis(~. / (max(sensibilidade$resultados$wcss) * 2), name = "Silhueta")
  ) +
  theme_minimal() +
  labs(title = "Análise de Sensibilidade para K-means",
       subtitle = paste("Média do", sensibilidade$metrica_nome, "entre execuções:", 
                        round(sensibilidade$ari_medio, 3)),
       x = "Execução", color = "Métrica") +
  scale_color_manual(values = c("WCSS" = "red", "Silhueta" = "blue"))

# Visualizar matriz de concordância
corrplot(sensibilidade$ari_matriz, 
         method = "circle", 
         type = "upper",
         title = paste(sensibilidade$metrica_nome, "entre Múltiplas Execuções"),
         mar = c(0, 0, 1, 0))

Pergunta: Com base na análise de sensibilidade, quão estáveis são os resultados do K-means para este conjunto de dados? Isso afeta sua confiança nas interpretações clínicas?

8 Conclusão e Recomendações

Neste exercício, você aplicou técnicas de análise de cluster para segmentar pacientes com base em indicadores de saúde. Os resultados podem ajudar a clínica a desenvolver programas de tratamento personalizados e otimizar recursos.

Exercícios Finais:

  1. Escreva um resumo de uma página sobre os principais achados desta análise, incluindo:

    • Número ideal de clusters e justificativa
    • Caracterização de cada grupo de pacientes
    • Recomendações clínicas específicas para cada grupo
    • Limitações da análise e sugestões para estudos futuros

  2. Como esta abordagem de segmentação de pacientes poderia ser implementada na prática clínica? Quais desafios você antecipa e como eles poderiam ser superados?

  3. Que variáveis adicionais poderiam ser incorporadas para melhorar a segmentação dos pacientes? Como essas variáveis poderiam impactar os resultados?